Imports

library(heatmaply)
library(igraph)
library(palmerpenguins)
library(tidyverse)
library(plotly)
library(randomNames)

get_edge_shapes <- function(edges, Xn, Yn, color = "k", width = 0.3) {
  # Get a list of edges with their shapes
  # shape is a line with a specific color, width
  # and x0/y0 (vertex 0) x1/y1 (vertex 1)
  
  # Get number of rows
  Ne <- nrow(edges)
  
  edge_shapes <- list()
  for(i in 1:Ne) {
    # Find vertices
    v0 <- edges[i,]$V1
    v1 <- edges[i,]$V2
    
    
    edge_shape = list(
      type = "line",
      line = list(color = color, width = 0.3),
      # X and y position of v0
      x0 = Xn[v0],
      y0 = Yn[v0],
      # X and y position of v1
      x1 = Xn[v1],
      y1 = Yn[v1]
    )
    
    # Add to edge_shapes
    edge_shapes[[i]] <- edge_shape
  }
  
  # Return
  edge_shapes
}

First use of ggplotly

# Read the CSV file
us_temps <- read_csv('../data/noaa_us_t2_table.csv', skip = 5) %>%
  select(1:13) %>% # Select month columns
  filter(Year < 2020) %>% # Remove 2020
  rowwise() %>% # Find average across all months
  mutate(
    # Average + Fahrenheit to Celsius
    Avg = (mean(c_across(2:13), na.rm = TRUE) - 32)*(5/9),
  ) %>%
  select(Year, Avg) # Select Year and Average columns
## Rows: 129 Columns: 23
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (23): Year, Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec, ...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(us_temps)
## # A tibble: 6 × 2
## # Rowwise: 
##    Year   Avg
##   <dbl> <dbl>
## 1  1895  10.2
## 2  1896  11.1
## 3  1897  10.9
## 4  1898  10.8
## 5  1899  10.6
## 6  1900  11.5
# ggplot with line plot
fig <- ggplot(data=us_temps, aes(x = Year, y = Avg)) +
  geom_line(size=1) +
  labs(
    # y label
    y="Average US Temperature (°C)"
  ) +
  theme_classic() + theme(
    axis.text.x = element_text(size = 11L), # font size
    axis.text.y = element_text(size = 11L)
  )
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Plotly comes in here!
plotly_fig <- ggplotly(fig)

plotly_fig

Customising layout and style

# Create a ggplot object
gg <- ggplot(mtcars, aes(x = wt, y = mpg)) +
  geom_point() +
  labs(title = "GGPlot Example", x = "Weight", y = "MPG") + 
  theme_classic()

# Convert the ggplot object to a Plotly plot
plot <- ggplotly(gg, width = 500, height = 500)

# Modify the layout and the style
plot <- plot %>%
  layout(
    xaxis = list(title = "<b>Weight (lbs)</b>", showgrid = TRUE),
    yaxis = list(title = "<b>Miles per Gallon</b>"),
    legend = list(x = 0.7, y = 0.9),
    annotations = list(list(x = 3, y = 20, text = "Annotation")),
    font = list(family = "Arial", size = 14),
    paper_bgcolor = "white"
  ) %>%
  style(
    hoverinfo="text",
    hoverlabel = list(bgcolor = "white")
  )

# Display the modified plot
plot

plot_ly for heatmaps

qol <- read.csv("../../dev/data/eqls_2007and2011_with_labels.csv")

# Select columns with "internet" or starting with "country_name"
selected_columns <- qol %>%
  select(matches("internet|^country_name"))

# Drop rows with missing values and calculate the mean by country_name
summary <- selected_columns %>%
  drop_na() %>%
  group_by(country_name) %>%
  summarise(across(everything(), mean))

# Rename columns
summary <- summary %>%
  rename_with(
    ~ gsub("phone_internet_contact_with_", "", .), # Remove "phone_internet_contact_with" from column names
    everything()
  ) %>%
  rename(
    # rename the column "how_frequently_use_the_internet_other_than_for_work"
    other_than_work = how_frequently_use_the_internet_other_than_for_work
  )

head(summary)
## # A tibble: 6 × 6
##   country_name   children parents other_relatives neighbours other_than_work
##   <chr>             <dbl>   <dbl>           <dbl>      <dbl>           <dbl>
## 1 Austria            2.73    3.97            2.97       2.46            3.00
## 2 Belgium            2.85    4.02            3.19       2.99            2.61
## 3 Bulgaria           3.14    4.56            3.51       2.67            3.98
## 4 Croatia            1.69    2.22            2.35       2.17            3.16
## 5 Cyprus             2.53    3.74            2.18       2.17            3.90
## 6 Czech Republic     2.78    4.05            3.26       2.88            3.02
# Matrix without the first column (country_name)
heatmap_matrix <- as.matrix(summary[, -1L])

# Define row and column names
rownames(heatmap_matrix) <- summary$country_name
colnames(heatmap_matrix) <- colnames(heatmap_matrix)

# Order rows alphabetically
ordered_rows <- rownames(heatmap_matrix)[order(rownames(heatmap_matrix))]

# Reorder the rows of the heatmap_matrix
heatmap_matrix_ordered <- heatmap_matrix[rev(ordered_rows), ]

head(heatmap_matrix_ordered)
##          children  parents other_relatives neighbours other_than_work
## UK       2.743682 4.008424        3.034296   2.670277        2.512034
## Turkey   2.703883 2.833738        2.754854   2.603155        3.978155
## Sweden   2.642746 4.012480        2.967239   2.151326        1.784711
## Spain    3.324975 4.157472        3.169509   2.833501        3.587763
## Slovenia 2.808357 4.136888        2.927954   2.180115        3.093660
## Slovakia 2.618987 4.169620        2.977215   2.453165        3.203797
# Number of colours (high value so we get something approximately continuous)
n_colors <- 100L

# Max and min of the color bar
vmin <- 1L
vmax <- 6L

heatmaply(
  heatmap_matrix_ordered,
  colors = colorRampPalette(c("#c13639", "white", "#2f79b5")),
  show_dendrogram = F,
  key.title = 'Score[1-6]'
)
# Attributes to plot
attributes <- c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g")

# Min-max normalisation
normalized_penguins <- penguins %>%
  mutate(across(attributes,
                ~ (. - min(., na.rm = TRUE)) / (max(., na.rm = TRUE) - min(., na.rm = TRUE))))
## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
##   # Was:
##   data %>% select(attributes)
## 
##   # Now:
##   data %>% select(all_of(attributes))
## 
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Mean by species
mean_values <- normalized_penguins %>%
  group_by(species) %>%
  summarise(across(c(attributes), mean, na.rm = TRUE))

# Start figure
fig <- plot_ly (
  type="scatterpolar",
  mode = "lines+markers",
  fill = "toself"
)

all_species = mean_values$species

for (i in 1:length(all_species)) {
  species_values <- as.character(
    mean_values %>% 
      filter(species == all_species[[i]]) %>% column_to_rownames("species")
  )

  fig <- fig %>% add_trace(
    r = c(species_values, species_values[[1]]),
    theta = c("Bill\nlength", "Bill\ndepth", "Flipper\nlength", "Body\nmass", "Bill\nlength"),
    name = all_species[[i]]
  )
}

fig <- fig %>%
  layout(
      polar = list(
        radialaxis = list(range = c(0,1)),
        angularaxis = list(
          rotation = 45 #, ticktext = 
        )
    ),
    font = list(size = 24)
  )

fig
data("UKfaculty", package="igraphdata")

# Upgrade the graph
G <- upgrade_graph(UKfaculty)

# Edges and nodes
edges <- as.data.frame(get.edgelist(G))
nodes <- V(G)

# Layout
nice_layout <- layout_nicely(G)

# X and Y positions
Xn <- nice_layout[, 1]
Yn <- nice_layout[, 2]

# Begin plot
network <- plot_ly(
  type = "scatter",
  mode = "markers"
)

# Add trace for nodes
network <- network %>% add_trace(
  x = Xn, 
  y = Yn,
  # Size of the points depends on the degree
  marker = list(size = degree(G)),
  # Text = random names
  text = randomNames(length(nodes)), 
  hoverinfo = "text",
  name = "Faculty members"
)


axis <- list(
  title = "", 
  showgrid = FALSE, 
  showticklabels = FALSE, 
  zeroline = FALSE
)

fig <- layout(
  network,
  shapes = get_edge_shapes(edges, Xn, Yn),
  xaxis = axis,
  yaxis = axis
)

fig
fig <- plot_ly(
 type = "sankey",
 orientation = "h",
 node = list(
  label = c("Alice's expense (in $)", "Bob's expense (in $)", "How much Alice ate", "How much Bob ate", "Cheese platter", "Wine"),
  pad = 15,
  thickness = 20,
  line = list(
   color = "black",
   width = 0.5
  )
 ),
 link = list(
  source = c(0, 1, 0, 2, 3, 3),
  target = c(2, 3, 3, 4, 4, 5),
  value = c(8, 4, 2, 8, 4, 2)
 )
)
fig %>% layout(
 title = "Basic Sankey Diagram",
 font = list(
  size = 10
 )
)
library(gganimate)
## Warning: package 'gganimate' was built under R version 4.2.3
library(gapminder)
## Warning: package 'gapminder' was built under R version 4.2.3
rstat <- ggplot(gapminder, aes(x = gdpPercap,y=lifeExp, 
                                  size = pop,
                                  colour = country)) +
      geom_point(show.legend = FALSE, alpha = 0.7) +
      scale_color_viridis_d() +
      scale_size(range = c(2, 12)) +
      scale_x_log10() +
  labs(x = "GDP per capita", y = "Life expectancy")
library(gganimate)
library(gapminder)

ranim <- rstat + 
  transition_time(year) + 
  labs(title = "Year: {frame_time}")

animate(ranim)